home *** CD-ROM | disk | FTP | other *** search
- /***********************************************************************
- *
- * C - Smalltalk Interface module
- *
- ***********************************************************************/
-
- /***********************************************************************
- *
- * Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
- * Written by Steve Byrne.
- *
- * This file is part of GNU Smalltalk.
- *
- * GNU Smalltalk is free software; you can redistribute it and/or modify it
- * under the terms of the GNU General Public License as published by the Free
- * Software Foundation; either version 1, or (at your option) any later
- * version.
- *
- * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
- * more details.
- *
- * You should have received a copy of the GNU General Public License along with
- * GNU Smalltalk; see the file COPYING. If not, write to the Free Software
- * Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
- *
- ***********************************************************************/
-
-
- /*
- * Change Log
- * ============================================================================
- * Author Date Change
- * sbb 23 Feb 92 Added support for reading and writing scalar types.
- *
- * sbb 19 Jul 91 Started adding support for the DLD package.
- *
- * sbb 22 Jan 91 Added putenv().
- *
- * sbb 17 Nov 90 Added support for UnixStream primitives.
- *
- * sbb 11 Aug 90 Added knowledge of byteArrayOut type.
- *
- * sbyrne 4 Jun 89 Added Smalltalk data conversion type.
- *
- * sbyrne 29 May 89 Created.
- *
- */
-
- /* Define this to enable initialization of the SunView hacks in the
- ./examples directory */
- /* #define SUN_WIN_HACKS */
-
- #include "mst.h"
- #include "mstinterp.h"
- #include "mstdict.h"
- #include "mstoop.h"
- #include "mstsym.h"
- #include "mstcallin.h"
-
- #define ARG_VEC_SIZE 20 /* 20 ints, 10 longs or ptrs, 5 dbls */
-
-
- typedef enum {
- intAlign,
- longAlign,
- ptrAlign,
- doubleAlign
- } AlignmentType;
-
- typedef enum { /* types for C parameters */
- unknownType, /* when there is no type a priori */
- charType,
- stringType,
- stringOutType, /* for things that modify string params */
- symbolType,
- byteArrayType,
- byteArrayOutType,
- intType,
- longType,
- doubleType,
- voidType, /* valid only as a return type */
- variadicType, /* for parameters, this param is an array
- to be interpreted as arguments. Note that
- only simple conversions are performed in
- this case. */
- cObjectType, /* a C object is being passed */
- smalltalkType /* no conversion to-from C...C sees this
- as "void *". */
- } CDataType;
-
- typedef struct CFuncDescriptorStruct {
- OBJ_HEADER;
- OOP cFunction;
- OOP cFunctionName;
- OOP returnType;
- OOP numFixedArgs;
- OOP argTypes[1]; /* variable length, really numFixedArgs long */
- } *CFuncDescriptor;
-
- typedef struct SymbolTypeMapStruct {
- OOP *symbol;
- CDataType type;
- } SymbolTypeMap;
-
- typedef struct StringInfoStruct {
- Byte *cString;
- OOP stringOOP;
- CDataType returnedType;
- } StringInfo;
-
- typedef union CParamUnionUnion {
- int intVal;
- long longVal;
- voidPtr ptrVal;
- double doubleVal;
- int valueVec[sizeof(double) / sizeof(int)];
- } CParamUnion;
-
- typedef struct CFuncInfoStruct {
- char *funcName;
- void (*funcAddr)();
- } CFuncInfo;
-
- extern int errno;
-
- void defineCFunc();
-
- static void pushObj(), callCFunction(),
- badType(), pushSmalltalkObj();
- static CDataType getCType();
- static CFuncDescriptor getCFuncDescriptor();
- static OOP classifyTypeSymbol();
- static int savedErrno;
-
- static OOP readChar();
- static OOP readUChar();
- static OOP readShort();
- static OOP readUShort();
- static OOP readLong();
- static OOP readULong();
- static OOP readFloat();
- static OOP readDouble();
-
- static void writeChar();
- static void writeShort();
- static void writeLong();
- static void writeFloat();
- static void writeDouble();
-
- static CFuncInfo cFuncInfo[100], *cFuncIndex = cFuncInfo;
- static int cArgVec[ARG_VEC_SIZE];
- static int *cArg;
- static StringInfo stringInfo[ARG_VEC_SIZE], *sip;
- /* printable names for corresponding C types */
- static char *cTypeName[] = {
- "void?", /* unknownType */
- "char", /* charType */
- "char *", /* stringType */
- "char *", /* stringOutType */
- "char *", /* symbolType */
- "char *", /* byteArrayType */
- "char *", /* byteArrayOutType */
- "int", /* intType */
- "long", /* longType */
- "double", /* doubleType */
- "void?", /* voidType */
- "var args?", /* variadicType */
- "void *", /* cObjectType */
- "void *", /* smalltalkType */
- };
-
- static SymbolTypeMap symbolTypeMap[] = {
- &unknownSymbol, unknownType,
- &charSymbol, charType,
- &stringSymbol, stringType,
- &stringOutSymbol, stringOutType,
- &symbolSymbol, symbolType,
- &byteArraySymbol, byteArrayType,
- &byteArrayOutSymbol, byteArrayOutType,
- &intSymbol, intType,
- &longSymbol, longType,
- &doubleSymbol, doubleType,
- &voidSymbol, voidType,
- &variadicSymbol, variadicType,
- &cObjectSymbol, cObjectType,
- &smalltalkSymbol, smalltalkType,
- nil, unknownType
- };
-
- /* the arg vec pointer must be = 0 mod alignments[align] */
- /* This is quite likely to be machine dependent. Currently it is set up
- * to work correctly on sun2's, sun3's and sun4's */
- static int alignments[] = {
- sizeof(int), /* intType */
- sizeof(long), /* longType */
- sizeof(voidPtr), /* ptrType */
- DOUBLE_ALIGNMENT /* doubleType */
- };
-
- static int typeSizes[] = {
- sizeof(int), /* intType */
- sizeof(long), /* longType */
- sizeof(voidPtr), /* ptrType */
- sizeof(double) /* doubleType */
- };
-
- /*
- * void marli(n)
- *
- * Description
- *
- * Test/example C function.
- *
- * Inputs
- *
- * n : number of times to emit message.
- *
- */
- void marli(n)
- int n;
- {
- int i;
-
- for (i = 0; i < n; i++) {
- printf("Marli loves Steve!!!\n");
- }
- }
-
- static int getErrno()
- {
- return (savedErrno);
- }
-
-
-
- #ifdef debugging /* Wed Nov 14 12:34:44 1990 */
- /**/myioctl(fd, request, arg)
- /**/int fd, request;
- /**/char *arg;
- /**/{
- /**/ printf("fd %d request %x arg %x\n", fd, request, arg);
- /**/ return (ioctl(fd, request, arg));
- /**/}
- #endif /* debugging Wed Nov 14 12:34:44 1990 */
-
- /*
- * static int my_putenv(str)
- *
- * Description
- *
- * Does a putenv library call. Exists because putenv (at least Sun's)
- * expects that the string passed in will exist for the duration, and
- * Smalltalk will free the string it passed to this this routine when
- * control returns to it.
- *
- * Inputs
- *
- * str : String to stuff into the environment. Of the form name=value.
- *
- * Outputs
- *
- * Returned value from putenv() call.
- */
- static int my_putenv(str)
- char *str;
- {
- char *clone;
- int len;
-
- len = strlen(str) + 1; /* hold the null */
- clone = (char *)malloc(len);
- strcpy(clone, str);
- return (putenv(clone));
- }
-
-
- static void testCallin(oop)
- OOP oop;
- {
- strMsgSend(oop, "inspect", nil);
- #ifdef preserved /* Tue Dec 31 21:55:47 1991 */
- /**/ OOP o, sel;
- /**/ double f;
- /**/
- /**/ sel = symbolToOOP("printNl");
- /**/ o = msgSend(stringToOOP(msg), sel, nil);
- /**/ strMsgSend(o, "inspect", nil);
- /**/ strMsgSend(strMsgSend(o, ",", o, nil), "printNl", nil);
- /**/ msgSendf(nil, "%s %s printNl", "this is a test");
- /**/ msgSendf(&f, "%f %i + %f", 3, 4.7);
- /**/ printf("result = %f\n", f);
- #endif /* preserved Tue Dec 31 21:55:47 1991 */
- }
-
- void initCFuncs()
- {
- extern void marli(), windowLoop();
- extern char *getAttrName();
- extern voidPtr *getAttrValue();
- extern void window_create();
- extern int system();
- extern char *getenv();
- extern int read(), write(), open(), close(), ioctl(), lseek()/*, tell()*/;
-
- defineCFunc("system", system);
- defineCFunc("getenv", getenv);
- defineCFunc("putenv", my_putenv);
-
- defineCFunc("open", open);
- defineCFunc("close", close);
- defineCFunc("read", read);
- defineCFunc("write", write);
- /* defineCFunc("ioctl", myioctl); */
- defineCFunc("ioctl", ioctl);
- defineCFunc("lseek", lseek);
- /* defineCFunc("tell", tell);*/
-
- /* just to round out the set */
- defineCFunc("readChar", readChar);
- defineCFunc("readUChar", readUChar);
- defineCFunc("readShort", readShort);
- defineCFunc("readUShort", readUShort);
- defineCFunc("readLong", readLong);
- defineCFunc("readULong", readULong);
- defineCFunc("readFloat", readFloat);
- defineCFunc("readDouble", readDouble);
-
- defineCFunc("writeChar", writeChar);
- defineCFunc("writeShort", writeShort);
- defineCFunc("writeLong", writeLong);
- defineCFunc("writeFloat", writeFloat);
- defineCFunc("writeDouble", writeDouble);
-
- defineCFunc("getErrno", getErrno);
-
- defineCFunc("testCallin", testCallin);
-
- #ifdef DLD
- initDldLib();
- #endif
-
- /* Non standard routines */
-
- defineCFunc("marli", marli);
- #ifdef SUN_WIN_HACKS
- defineWindowFuncs();
- #endif /* SUN_WIN_HACKS */
-
- #ifdef notdefined
- defineCFunc("getAttrName", getAttrName);
- defineCFunc("getAttrValue", getAttrValue);
- #endif
- }
-
- static OOP readChar(fd)
- int fd;
- {
- char c;
-
- if (read(fd, &c, sizeof(c)) != sizeof(c)) {
- return (nilOOP);
- }
-
- return (charOOPAt(c));
- }
-
- static OOP readUChar(fd)
- int fd;
- {
- unsigned char c;
-
- if (read(fd, &c, sizeof(c)) != sizeof(c)) {
- return (nilOOP);
- }
-
- return (charOOPAt(c));
- }
-
- static OOP readShort(fd)
- int fd;
- {
- short s;
-
- if (read(fd, &s, sizeof(s)) != sizeof(s)) {
- return (nilOOP);
- }
-
- return (fromInt(s));
- }
-
- static OOP readUShort(fd)
- int fd;
- {
- unsigned short s;
-
- if (read(fd, &s, sizeof(s)) != sizeof(s)) {
- return (nilOOP);
- }
-
- return (fromInt(s));
- }
-
- static OOP readLong(fd)
- int fd;
- {
- long l;
-
- if (read(fd, &l, sizeof(l)) != sizeof(l)) {
- return (nilOOP);
- }
-
- return (fromInt(l));
- }
-
- static OOP readULong(fd)
- int fd;
- {
- unsigned long l;
-
- if (read(fd, &l, sizeof(l)) != sizeof(l)) {
- return (nilOOP);
- }
-
- return (fromInt(l));
- }
-
- static OOP readFloat(fd)
- int fd;
- {
- float f;
-
- if (read(fd, &f, sizeof(f)) != sizeof(f)) {
- return (nilOOP);
- }
-
- return (floatNew(f));
- }
-
- static OOP readDouble(fd)
- int fd;
- {
- double d;
-
- if (read(fd, &d, sizeof(d)) != sizeof(d)) {
- return (nilOOP);
- }
-
- return (floatNew(d));
- }
-
- static void writeChar(fd, c)
- int fd;
- char c;
- {
- write(fd, &c, sizeof(c));
- }
-
- static void writeShort(fd, s)
- int fd;
- short s;
- {
- write(fd, &s, sizeof(s));
- }
-
- static void writeLong(fd, l)
- int fd;
- long l;
- {
- write(fd, &l, sizeof(l));
- }
-
- static void writeFloat(fd, f)
- int fd;
- float f;
- {
- write(fd, &f, sizeof(f));
- }
-
- static void writeDouble(fd, d)
- int fd;
- double d;
- {
- write(fd, &d, sizeof(d));
- }
-
-
- #ifdef DLD
-
- /***********************************************************************
- *
- * GNU Dynamic Linking support code
- *
- ***********************************************************************/
-
- #include <dld.h>
-
- char *dldArgv0;
-
- static int getUndefinedSymCount()
- {
- return (dld_undefined_sym_count);
- }
-
-
- initDldLib()
- {
- if (dld_init (dld_find_executable (dldArgv0)) == 0) {
- defineCFunc("dldLink", dld_link);
- defineCFunc("dldUnlinkByFile", dld_unlink_by_file);
- defineCFunc("dldUnlinkBySymbol", dld_unlink_by_symbol);
- defineCFunc("dldGetSymbol", dld_get_symbol);
- defineCFunc("dldGetFunc", dld_get_func);
- defineCFunc("dldFunctionExecutableP", dld_function_executable_p);
- defineCFunc("dldListUndefinedSym", dld_list_undefined_sym);
- defineCFunc("dldCreateReference", dld_create_reference);
- defineCFunc("dldDefineSym", dld_define_sym);
- defineCFunc("dldRemoveDefinedSymbol", dld_remove_defined_symbol);
-
- defineCFunc("getUndefinedSymCount", getUndefinedSymCount);
-
- /* so user level code can invoke it! */
- defineCFunc("defineCFunc", defineCFunc);
- }
- }
-
- #endif
-
-
- void defineCFunc(funcName, funcAddr)
- char *funcName;
- void (*funcAddr)();
- {
- cFuncIndex->funcName = funcName;
- cFuncIndex->funcAddr = funcAddr;
- cFuncIndex++;
- }
-
- void (*lookupFunction(funcName))()
- char *funcName;
- {
- CFuncInfo *fip;
-
- for (fip = cFuncInfo; fip < cFuncIndex; fip++) {
- if (strcmp(funcName, fip->funcName) == 0) {
- return (fip->funcAddr);
- }
- }
- return (nil);
- }
-
-
-
- /*
- * void invokeCRoutine(numArgs, methodOOP)
- *
- * Description
- *
- * Invokes a C routine. The Smalltalk arguments have been popped off the
- * Smalltalk stack when this routine returns.
- *
- * Inputs
- *
- * numArgs:
- *
- * methodOOP:
- *
- *
- */
- void invokeCRoutine(numArgs, methodOOP)
- long numArgs;
- OOP methodOOP;
- {
- CFuncDescriptor desc;
- CDataType cType;
- OOP oop; /* oopArgVec[32]; */
- int i;
-
- cArg = cArgVec;
-
- desc = getCFuncDescriptor(methodOOP);
-
- sip = stringInfo;
-
- for (i = 0; i < numArgs; i++) {
- oop = stackAt(numArgs - i - 1);
- cType = getCType(desc, i);
- pushSmalltalkObj(oop, cType);
- }
-
- popNOOPs(numArgs);
-
- callCFunction(desc);
-
- /* Fixup all returned string variables */
- for ( ; sip-- != stringInfo; ) {
- if (sip->returnedType == stringOutType) {
- setOOPString(sip->stringOOP, sip->cString);
- } else if (sip->returnedType == byteArrayOutType) {
- setOOPBytes(sip->stringOOP, sip->cString);
- }
- free(sip->cString);
- }
- }
-
- static CFuncDescriptor getCFuncDescriptor(methodOOP)
- OOP methodOOP;
- {
- OOP associationOOP, descOOP;
-
- associationOOP = methodLiteralExt(methodOOP, 0);
- descOOP = associationValue(associationOOP);
- return ((CFuncDescriptor)oopToObj(descOOP));
- }
-
- static CDataType getCType(desc, index)
- CFuncDescriptor desc;
- int index;
- {
- if (index < toInt(desc->numFixedArgs)) {
- return ((CDataType)toInt(desc->argTypes[index]));
- } else {
- return (unknownType);
- }
- }
-
- static void pushSmalltalkObj(oop, cType)
- OOP oop;
- CDataType cType;
- {
- OOP class;
- int i;
- CParamUnion u;
-
- if (cArg - cArgVec >= ARG_VEC_SIZE) {
- errorf("Attempt to push more than %d ints; extra parameters ignored",
- ARG_VEC_SIZE);
- return;
- }
-
- if (isInt(oop)) {
- class = integerClass;
- } else if (oop == trueOOP || oop == falseOOP) {
- class = booleanClass;
- } else {
- class = oopClass(oop);
- }
-
- if (cType == smalltalkType) {
- u.ptrVal = (voidPtr)oop;
- registerOOP(oop); /* make sure it doesn't get gc'd */
- pushObj(&u, ptrAlign);
- } else if (class == integerClass) {
- if (cType == longType || cType == unknownType) {
- u.longVal = toInt(oop);
- pushObj(&u, longAlign);
- } else if (cType == intType || cType == charType) {
- u.intVal = toInt(oop);
- pushObj(&u, intAlign);
- } else {
- badType("Integer", cType);
- }
- } else if (class == booleanClass) {
- if (cType == intType || cType == charType || cType == unknownType) {
- u.intVal = (oop == trueOOP);
- pushObj(&u, intAlign);
- } else if (cType == longType) {
- u.longVal = (oop == trueOOP);
- pushObj(&u, longAlign);
- } else {
- badType("Boolean", cType);
- }
- } else if (class == charClass) {
- if (cType == charType || cType == unknownType) {
- u.intVal = charOOPValue(oop);
- pushObj(&u, intAlign);
- } else {
- badType("Character", cType);
- }
- } else if (class == stringClass) {
- if (cType == stringType || cType == stringOutType
- || cType == unknownType) {
- if (sip - stringInfo >= ARG_VEC_SIZE) {
- errorf("Too many string arguments, max is %d. Extra ignored",
- ARG_VEC_SIZE);
- }
- sip->cString = toCString(oop);
- u.ptrVal = (voidPtr)sip->cString;
- sip->stringOOP = oop;
- sip->returnedType = cType;
- sip++;
- pushObj(&u, ptrAlign);
- } else {
- badType("String", cType);
- }
- } else if (class == symbolClass) {
- if (cType == symbolType || cType == stringType || cType == unknownType) {
- if (sip - stringInfo >= ARG_VEC_SIZE) {
- errorf("Too many string arguments, max is %d. Extra ignored",
- ARG_VEC_SIZE);
- }
- sip->cString = toCString(oop);
- u.ptrVal = (voidPtr)sip->cString;
- sip->stringOOP = oop;
- sip->returnedType = cType;
- sip++;
- pushObj(&u, ptrAlign);
- } else {
- badType("Symbol", cType);
- }
- } else if (class == byteArrayClass) {
- if (cType == byteArrayType || cType == byteArrayOutType
- || cType == unknownType) {
- if (sip - stringInfo >= ARG_VEC_SIZE) {
- errorf("Too many string arguments, max is %d. Extra ignored",
- ARG_VEC_SIZE);
- }
- sip->cString = toByteArray(oop);
- u.ptrVal = (voidPtr)sip->cString;
- sip->stringOOP = oop;
- sip->returnedType = cType;
- sip++;
- pushObj(&u, ptrAlign);
- } else {
- badType("ByteArray", cType);
- }
- } else if (class == floatClass) {
- if (cType == doubleType || cType == unknownType) {
- u.doubleVal = floatOOPValue(oop);
- pushObj(&u, doubleAlign);
- } else {
- badType("Float", cType);
- }
- } else if (class == cObjectClass) {
- if (cType == cObjectType || cType == unknownType) {
- u.ptrVal = cObjectValue(oop);
- pushObj(&u, ptrAlign);
- } else {
- badType("CObject", cType);
- }
- } else if ((cType == cObjectType || cType == unknownType)
- && isAKindOf(class, cObjectClass)) {
- u.ptrVal = cObjectValue(oop);
- pushObj(&u, ptrAlign);
- } else if (class == undefinedObjectClass) { /* how to encode nil */
- switch (cType) {
- case cObjectType:
- case stringType:
- case symbolType:
- case unknownType:
- u.ptrVal = nil;
- pushObj(&u, ptrAlign);
- break;
-
- default:
- badType("UndefinedObject", cType);
- }
- } else if (class == arrayClass) {
- for (i = 1; i <= numOOPs(oopToObj(oop)); i++) {
- pushSmalltalkObj(arrayAt(oop, i), unknownType);
- }
- }
-
- }
-
- static void pushObj(up, align)
- CParamUnion *up;
- AlignmentType align;
- {
- int i, alignInts;
-
- alignInts = alignments[ENUM_INT(align)] / sizeof(int);
-
- /* Align the stack properly */
- if ((cArg - cArgVec) % alignInts) {
- cArg += alignInts - ((cArg - cArgVec) % alignInts);
- }
-
- for (i = 0; i < typeSizes[ENUM_INT(align)] / sizeof(int); i++) {
- if (cArg - cArgVec >= ARG_VEC_SIZE) {
- errorf("Too many parameters, max = %d. Extra parameters ignored",
- ARG_VEC_SIZE);
- return;
- }
- *cArg++ = up->valueVec[i];
- }
- }
-
- static void callCFunction(desc)
- CFuncDescriptor desc;
- {
- int intResult;
- long longResult;
- double doubleResult;
- int (*cFunction)();
- CDataType returnType;
- OOP returnTypeOOP;
-
- cFunction = (int (*)())cObjectValue(desc->cFunction);
- if (isInt(desc->returnType)) {
- returnType = (CDataType)toInt(desc->returnType);
- returnTypeOOP = nil;
- } else {
- returnTypeOOP = desc->returnType;
- returnType = cObjectType;
- }
-
- switch (returnType) {
- case voidType:
- (*cFunction)(
- cArgVec[0], cArgVec[1], cArgVec[2], cArgVec[3],
- cArgVec[4], cArgVec[5], cArgVec[6], cArgVec[7],
- cArgVec[8], cArgVec[9], cArgVec[10], cArgVec[11],
- cArgVec[12], cArgVec[13], cArgVec[14], cArgVec[15],
- cArgVec[16], cArgVec[17], cArgVec[18], cArgVec[19]);
- break;
- case charType:
- case intType:
- intResult = (*cFunction)(
- cArgVec[0], cArgVec[1], cArgVec[2], cArgVec[3],
- cArgVec[4], cArgVec[5], cArgVec[6], cArgVec[7],
- cArgVec[8], cArgVec[9], cArgVec[10], cArgVec[11],
- cArgVec[12], cArgVec[13], cArgVec[14], cArgVec[15],
- cArgVec[16], cArgVec[17], cArgVec[18], cArgVec[19]);
- switch (returnType) {
- case intType:
- setStackTop(fromInt((long)intResult));
- break;
- case charType:
- setStackTop(charOOPAt((Byte)intResult));
- break;
- }
- break;
-
- case longType:
- case stringType:
- case symbolType:
- case cObjectType:
- case smalltalkType:
- longResult = (*(long (*)())cFunction)(
- cArgVec[0], cArgVec[1], cArgVec[2], cArgVec[3],
- cArgVec[4], cArgVec[5], cArgVec[6], cArgVec[7],
- cArgVec[8], cArgVec[9], cArgVec[10], cArgVec[11],
- cArgVec[12], cArgVec[13], cArgVec[14], cArgVec[15],
- cArgVec[16], cArgVec[17], cArgVec[18], cArgVec[19]);
- switch (returnType) {
- case longType:
- setStackTop(fromInt(longResult));
- break;
- case stringType:
- if (longResult == 0) {
- setStackTop(nilOOP);
- } else {
- setStackTop(stringNew((char *)longResult));
- }
- break;
- case symbolType:
- if (longResult == 0) {
- setStackTop(nilOOP);
- } else {
- setStackTop(internString((char *)longResult));
- }
- break;
- case cObjectType:
- if (longResult == 0) {
- setStackTop(nilOOP);
- } else {
- if (returnTypeOOP) {
- setStackTop(cObjectNewTyped((voidPtr)longResult, returnTypeOOP));
- } else {
- setStackTop(cObjectNew((voidPtr)longResult));
- }
- }
- break;
- case smalltalkType:
- setStackTop((OOP)longResult);
- break;
- }
- break;
-
- case doubleType:
- doubleResult = (*(double (*)())cFunction)(
- cArgVec[0], cArgVec[1], cArgVec[2], cArgVec[3],
- cArgVec[4], cArgVec[5], cArgVec[6], cArgVec[7],
- cArgVec[8], cArgVec[9], cArgVec[10], cArgVec[11],
- cArgVec[12], cArgVec[13], cArgVec[14], cArgVec[15],
- cArgVec[16], cArgVec[17], cArgVec[18], cArgVec[19]);
- setStackTop(floatNew(doubleResult));
- break;
-
- default:
- errorf("Invalid C function return type specified, index %d\n",
- returnType);
- break;
- }
-
- savedErrno = errno;
- }
-
- static void badType(smalltalkTypeName, cType)
- char *smalltalkTypeName;
- CDataType cType;
- {
- errorf("Attempt to pass a %s as a %s", smalltalkTypeName,
- cTypeName[ENUM_INT(cType)]);
- }
-
-
- OOP makeDescriptor(funcNameOOP, returnTypeOOP, argsOOP)
- OOP funcNameOOP, returnTypeOOP, argsOOP;
- {
- char *funcName;
- void (*funcAddr)();
- int numArgs, i;
- CFuncDescriptor desc;
-
- funcName = (char *)toCString(funcNameOOP);
- funcAddr = lookupFunction(funcName);
-
- if (argsOOP == nilOOP) {
- numArgs = 0;
- } else {
- numArgs = numOOPs(oopToObj(argsOOP));
- }
-
- /*
- * since these are all either ints or new objects, I'm not moving the
- * oops
- */
- desc = (CFuncDescriptor)newInstanceWith(cFuncDescriptorClass, numArgs);
- desc->cFunction = cObjectNew(funcAddr);
- desc->cFunctionName = stringNew(funcName);
- desc->numFixedArgs = fromInt(numArgs);
- desc->returnType = classifyTypeSymbol(returnTypeOOP, true);
- for (i = 1; i <= numArgs; i++) {
- desc->argTypes[i - 1] = classifyTypeSymbol(arrayAt(argsOOP, i), false);
- }
-
- return (allocOOP(desc));
- }
-
- static OOP classifyTypeSymbol(symbolOOP, isReturn)
- OOP symbolOOP;
- Boolean isReturn;
- {
- SymbolTypeMap *sp;
- Byte *symbolName;
-
- for (sp = symbolTypeMap; sp->symbol != nil; sp++) {
- if (*sp->symbol == symbolOOP) {
- return (fromInt(sp->type));
- }
- }
-
- if (isReturn) {
- if (isClass(symbolOOP, cTypeClass)) {
- return (symbolOOP); /* this is the type we want! */
- }
- }
-
- symbolName = toCString(symbolOOP); /* yeah yeah...but they have the same
- representation! */
- errorf("Unknown data type symbol: %s", symbolName);
-
- return (fromInt(unknownType));
- }
-
- /*
- * void restoreCFuncDescriptor(cFuncDescOOP)
- *
- * Description
- *
- * This routine is called during image loading to restore a C function
- * descriptor pointer. This is because between the time that the image
- * was made and now, the executable image may have changed, so any
- * reference to the C function address may be invalid. We therefore just
- * perform the function lookup again and use that value.
- *
- * Inputs
- *
- * cFuncDescOOP:
- * A C function descriptor object to be adjusted. Contains the
- * name of the function to be looked up.
- *
- */
- void restoreCFuncDescriptor(cFuncDescOOP)
- OOP cFuncDescOOP;
- {
- CFuncDescriptor desc;
- void (*funcAddr)();
- char *funcName;
-
- desc = (CFuncDescriptor)oopToObj(cFuncDescOOP);
- funcName = (char *)toCString(desc->cFunctionName);
- funcAddr = lookupFunction(funcName);
- setCObjectValue(desc->cFunction, funcAddr);
- }
-
-
- /***********************************************************************
- *
- * Call-in support code
- *
- ***********************************************************************/
-
-
- #ifdef not_working_yet
- send(receiver, selectorStr, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
- arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17,
- arg18, arg19, arg20)
- OOP receiver, selector;
- OOP arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
- arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20;
- {
- }
-
- OOP newIntObject(i)
- long i;
- {
- return (fromInt(i));
- }
-
- OOP newCharObject(c)
- Byte c;
- {
- return (charOOPAt(c));
- }
-
- OOP newFloatObject(f)
- double f;
- {
- OOP oop;
-
- oop = floatNew(f);
- registerOOP(oop);
- return (oop);
- }
-
- ??? Want byte array types ???
-
- OOP newStringObject(str)
- char *str;
- {
- OOP oop;
-
- if (str == nil) {
- return (nilOOP);
- } else {
- oop = stringNew(str);
- registerOOP(oop);
- return (oop);
- }
- }
-
- OOP newSymbolObject(str)
- char *str;
- {
- OOP oop;
-
- if (str == nil) {
- return (nilOOP);
- } else {
- oop = internString(str);
- return (oop);
- }
- }
-
-
- OOP newCObject(cObject)
- voidPtr cObject;
- {
- OOP oop;
-
- if (cObject == nil) {
- return (nilOOP);
- } else {
- oop = cObjectNew(cObject);
- registerOOP(oop);
- return (oop);
- }
- }
-
- objectType(oop)
- returns the type of an object, an enum, or unknown
-
- need back conversion routines
-
- void freeObject(oop)
- OOP oop;
- {
- printf("!!! IMPLEMENT freeObject\n");
- }
-
-
- static void registerOOP(oop)
- OOP oop;
- {
- printf("!!! IMPLEMENT registerOOP\n");
- }
-
- #endif /* not_done_yet */
-